; ORIGINAL: 3dt2.1/examples/schemers/flight.scm
;;
;; flight.scm
;;
;; A sample fly-through program, using the castle produced by loading
;; the file  castle.scm.  (This program assumes that that file has already
;; been loaded.)
;;
;; Edward C. Martin, Schemers Inc.
;; 22 December 1993
;; 08 November 1994, removed all mention of the void object, to ensure
;; compatibility with Elk2.2
;;

(require 'castle "castle.scm")

;; Defines the flight path through the castle produced by  castle.scm.
;; The path is not shown on the screen.
;;
(define flight-path
  (let ((old-auto (env:auto-display)))
    (env:set-auto-display OFF)
    (let* ((path (edge:spline
                   (list
                     (position 0 -80 80)
                     (position 0 -58.5 42)
                     (position 0 -50 21)
                     (position 0 -41.5 4)
                     (position -10 -20 10)
                     (position -20 0 25)
                     (position -20 20 50)
                     (position 0 20 20)
                     (position 10 20 10)
                     (position 25 -25 16))
                   #f
                   (gvector 1 -1 0))))
      (env:set-auto-display old-auto)
      path)))

;; (fly path tlist dist)
;; flies along the input  path,  taking snapshots at points whose parameters
;; appear in  tlist  with a view distance of  dist.
;;
(define fly
  (lambda (path tlist dist)
    (letrec ((local-view
               (lambda (s)
                 (if (null? s)
                     (display "Thank you for flying Bee Airlines.\n")
                     (let* ((t (car s))
                            (eye-pos (curve:eval-pos path t))
                            (look-dir (gvector:scale
                                        (gvector:unitize
                                          (curve:eval-tan path t))
                                        dist)))
                       (view:set-eye eye-pos C-view)
                       (view:set-target
                         (position:offset eye-pos look-dir) C-view)
                       (render (list C stack) C-view)
                       (local-view (cdr s)))))))
      (display "Hold on to your seats! We're off!\n")
      (view:set-perspective ON C-view)
      (local-view tlist))))

;; (in-flight-view path t dist)
;; shows the view at the point with parameter  t  on the input  path,  with
;; a view distance of  dist.
;;
(define in-flight-view
  (lambda (path t dist)
    (let* ((eye-pos (curve:eval-pos path t))
           (look-dir (gvector:scale
                       (gvector:unitize
                         (curve:eval-tan path t))
                       dist)))
      (view:set-perspective ON C-view)
      (view:set-eye eye-pos C-view)
      (view:set-target (position:offset eye-pos look-dir) C-view)
      (render (list C stack) C-view)
      'done)))

;; (tlist-generator mint maxt inct)
;; produces a list of parameters starting with  mint  and proceeding at
;; intervals of  inct  until just before  maxt  is reached or exceeded.
;; (maxt  itself is not included.)
;;
(define tlist-generator
  (lambda (mint maxt inct)
    (let ((next (+ mint inct)))
      (let ((diff (- next maxt)))
        (if (or (>= diff 0)
                (< (/ inct -1000) diff))
            (list mint)
            (cons mint (tlist-generator next maxt inct)))))))

;; (safe-move? current-eye intended-dir distance)
;; tests whether or not the proposed motion will bump into the castle.
;; Returns #t if OK to fly; #f if collision will occur.
;;
(define safe-move?
  (lambda (current-eye intended-dir distance)
    (let ((intersection
            (solid:ray-test C (ray current-eye intended-dir))))
      (or (null? intersection)
          (> (position:distance current-eye (cdar intersection))
             distance)))))

;; (forward n)
;; moves the eye  n  units forward in the direction of travel, and renders
;; the new image.
;;
(define forward
  (lambda (n)
    (let ((eye (view:eye C-view))
          (target (view:target C-view)))
      (let ((trans-dir (gvector:scale
                         (gvector:unitize
                           (gvector:from-to eye target))
                         n)))
        (if (safe-move? eye trans-dir n)
            (begin
              (view:set-eye (position:offset eye trans-dir) C-view)
              (view:set-target (position:offset target trans-dir) C-view)
              (render (list C stack) C-view)
              'ok)
            (begin
              (display "You will collide with the castle if you fly\n")
              (display "that far. Please choose a shorter distance.\n"))
            )))))

;; (back n)
;; moves the eye  n  units back while continuing to face the same way, and
;; and renders the new image.
;;
(define back
  (lambda (n)
    (let ((eye (view:eye C-view))
          (target (view:target C-view)))
      (let ((trans-dir (gvector:scale
                         (gvector:unitize
                           (gvector:from-to eye target))
                         (- n))))
        (if (safe-move? eye trans-dir n)
            (begin
              (view:set-eye (position:offset eye trans-dir) C-view)
              (view:set-target (position:offset target trans-dir) C-view)
              (render (list C stack) C-view)
              'ok)
            (begin
              (display "You will collide with the castle if you fly\n")
              (display "that far. Please choose a shorter distance.\n"))
            )))))

;; (left k)
;; turns the direction of travel  k  degrees to the left. (k  must be no
;; greater than 45.)
;;
(define left
  (lambda (k)
    (if (not (and (<= 0 k) (<= k 45)))
        (begin
          (display "The number of degrees you turn must\n")
          (display "be between 0 and 45. Please try again.\n"))
        (let ((eye (view:eye C-view))
              (target (view:target C-view))
              (krad (/ (* k PI) 180)))
          (let ((uviewdir (gvector:unitize
                            (gvector:from-to eye target))))
            (let ((unorm (gvector:unitize
                           (gvector:cross
                             (view:up C-view) uviewdir))))
              (let ((newdir
                      (gvector:scale
                        (gvector:+
                          (gvector:scale unorm (sin krad))
                          (gvector:scale uviewdir (cos krad)))
                        50)))
                (begin
                  (view:set-target (position:offset eye newdir) C-view)
                  (render (list C stack) C-view)
                  'ok))))))))

;; (right k)
;; turns the direction of travel  k  degrees to the right. (k  must be no
;; greater than 45.)
;;
(define right
  (lambda (k)
    (if (not (and (<= 0 k) (<= k 45)))
        (begin
          (display "The number of degrees you turn must\n")
          (display "be between 0 and 45. Please try again.\n"))
        (let ((eye (view:eye C-view))
              (target (view:target C-view))
              (krad (/ (* k PI) 180)))
          (let ((uviewdir (gvector:unitize
                            (gvector:from-to eye target))))
            (let ((unorm (gvector:unitize
                           (gvector:cross
                             uviewdir (view:up C-view)))))
              (let ((newdir
                      (gvector:scale
                        (gvector:+
                          (gvector:scale unorm (sin krad))
                          (gvector:scale uviewdir (cos krad)))
                        50)))
                (begin
                  (view:set-target (position:offset eye newdir) C-view)
                  (render (list C stack) C-view)
                  'ok))))))))

;; (up d)
;; turns the direction of travel  d  degrees up. (d  must be no greater
;; than 45.)
;;
(define up
  (lambda (d)
    (if (not (and (<= 0 d) (<= d 45)))
        (begin
          (display "The number of degrees you turn must\n")
          (display "be between 0 and 45. Please try again.\n"))
        (let ((eye (view:eye C-view))
              (target (view:target C-view))
              (up-dir (view:up C-view))
              (angle (/ (* d PI) 180)))
          (let ((uviewdir (gvector:unitize
                            (gvector:from-to eye target)))
                (cs (cos angle)))
            (let ((dot (gvector:dot up-dir uviewdir)))
              (let ((k (sqrt (/ (- 1 (* cs cs)) (- 1 (* dot dot))))))
                (let ((l (- cs (* k dot))))
                  (let ((newdir
                          (gvector:scale
                            (gvector:+
                              (gvector:scale uviewdir l)
                              (gvector:scale up-dir k))
                            50)))
                    (begin
                      (view:set-target (position:offset eye newdir) C-view)
                      (render (list C stack) C-view)
                      'ok))))))))))

;; (down d)
;; turns the direction of travel  d  degrees down. (d  must be no greater
;; than 45.)
;;
(define down
  (lambda (d)
    (if (not (and (<= 0 d) (<= d 45)))
        (begin
          (display "The number of degrees you turn must\n")
          (display "be between 0 and 45. Please try again.\n"))
        (let ((eye (view:eye C-view))
              (target (view:target C-view))
              (up-dir (view:up C-view))
              (angle (/ (* d PI) 180)))
          (let ((uviewdir (gvector:unitize
                            (gvector:from-to eye target)))
                (cs (cos angle)))
            (let ((dot (gvector:dot up-dir uviewdir)))
              (let ((k (sqrt (/ (- 1 (* cs cs)) (- 1 (* dot dot))))))
                (let ((l (- cs (* k dot))))
                  (let ((newdir
                          (gvector:scale
                            (gvector:+
                              (gvector:scale uviewdir l)
                              (gvector:scale up-dir (- k)))
                            50)))
                    (begin
                      (view:set-target (position:offset eye newdir) C-view)
                      (render (list C stack) C-view)
                      'ok))))))))))

;; (restart)
;; returns to the end situation of the original flight, just inside the
;; portcullis.
;;
(define restart
  (lambda ()
    (in-flight-view flight-path 0.975 50)))

;; runs the flight demonstration
;;
(fly flight-path (tlist-generator 0 1 0.075) 50)

;;
;; end of file  flight.scm
